library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.5 ✔ purrr 0.3.4
## ✔ tibble 3.1.6 ✔ dplyr 1.0.8
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
theme_set(theme_minimal())
library(broom)
library(patchwork)
library(ggbeeswarm)
library(dagitty)
library(ggdag)
##
## Attaching package: 'ggdag'
## The following object is masked from 'package:stats':
##
## filter
## <https://cran.r-project.org/web/packages/ggdag/vignettes/intro-to-ggdag.html>
library(gt)
library(flextable)
##
## Attaching package: 'flextable'
## The following object is masked from 'package:purrr':
##
## compose
library(officer)
library(gtsummary)
##
## Attaching package: 'gtsummary'
## The following objects are masked from 'package:flextable':
##
## as_flextable, continuous_summary
## Need Hmisc for bootstrap CIs in some plots, but don't want to load it
find.package('Hmisc')
## [1] "/Users/danhicks/Library/Caches/org.R-project.R/R/renv/library/transparency-b4b6f02c/R-4.1/x86_64-apple-darwin17.0/Hmisc"
library(here)
## here() starts at /Users/danhicks/Google Drive/Writing/transparency
## Helper functions for regression tables, DAG visualization, and effects and prediction plots for regression models
source(here('R', 'reg_tbl.R'))
source(here('R', 'plot_adjustments.R'))
source(here('R', 'reg_plots.R'))
## More readable contrasts in regression models
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
## The following object is masked from 'package:purrr':
##
## some
options(contrasts = c('contr.Treatment', 'contr.poly'))
options(decorate.contr.Treatment = '')
out_dir = here('out')
if (!dir.exists(out_dir)) {
dir.create(out_dir)
}
data_dir = here('data')
## Load data ----
## Elliott et al. data
emad_df = read_rds(here(data_dir, 'emad.Rds'))
## Our data
dataf = read_rds(here(data_dir, 'data.Rds'))
## Descriptive summary of our data ----
Several of our variables allow respondents to select multiple values, eg, race-ethnicity. These are downloaded as factors, with levels such as 5 or 2,4,5. We recode these as characters for the demographic summary table. Because these are just used as adjustment variables in the analysis, we don’t recode them for use below.
re_labels = c('American Indian or Alaskan Native',
'Asian or Pacific Islander',
'Black',
'Hispanic',
'White',
'Other',
'Prefer not to answer')
relig_labels = c('Buddhist',
'Catholic',
'Hindu',
'Jewish',
'Muslim',
'Protestant',
'No religion',
'Other', 'Prefer not to answer')
relig_serv_labels = c('Never',
'A few times per year',
'Once every month or two',
'2-3 times per month',
'Once per week',
'More than once per week',
'Daily')
poli_id_labels = c('Strongly liberal',
'Moderately liberal',
'Mildly liberal',
'Centrist',
'Mildly conservative',
'Moderately conservative',
'Strongly conservative',
'Other',
'Prefer not to answer')
poli_aff_labels = c('Democratic party',
'Republican party',
'Independent/no party',
'Other',
'Prefer not to answer')
edu_labels = c('Less than high school',
'High school, or some college',
'Bachelor’s degree or higher')
fix_multifac = function(vec, labs, ordered = FALSE) {
chr = vec |>
as.character() |>
str_split(',') |>
map(~ labs[as.integer(.x)]) |>
map_chr(str_c, collapse = '/')
if (!ordered) {
return(chr)
} else {
fct_relevel(chr, labs)
}
}
demo_gt = dataf |>
select(pid, age, gender, race_ethnicity,
religious_affil, religious_serv,
political_ideology, political_affiliation,
education, part_values, disclosure) |>
mutate(gender = fct_drop(gender),
race_ethnicity = fix_multifac(race_ethnicity, re_labels),
religious_affil = fix_multifac(religious_affil, relig_labels),
religious_serv = fix_multifac(religious_serv,
relig_serv_labels,
ordered = TRUE),
political_ideology = fix_multifac(political_ideology,
poli_id_labels,
ordered = TRUE),
political_affiliation = fix_multifac(political_affiliation,
poli_aff_labels),
education = fix_multifac(education, edu_labels, ordered = TRUE)) |>
select(-pid) |>
tbl_summary(label = list(race_ethnicity ~ 'race/ethnicity',
religious_affil ~ 'religious affiliation',
religious_serv ~ 'religious service attendance',
political_ideology ~ 'political ideology',
political_affiliation ~ 'political affiliation',
part_values ~ 'participant values'),
sort = list(race_ethnicity ~ 'frequency',
religious_affil ~ 'frequency')) |>
bold_labels()
## Warning: Unknown levels in `f`: Other, Prefer not to answer
demo_gt |>
as_flex_table() |>
save_as_docx(path = here(out_dir, '03_demo_table.docx'),
pr_section = prop_section(
page_size = page_size(orient = "landscape")
)
)
condition_tbl = dataf |>
mutate(disclose_values = case_when(
!disclosure ~ 'no disclosure',
disclosure ~ sci_values),
disclose_values = fct_relevel(disclose_values,
'no disclosure',
'public health',
'economic growth')) |>
select(disclose_values, conclusion) |>
tbl_summary(by = conclusion,
label = list(disclose_values ~ 'disclosure/values'))
condition_tbl
| Characteristic | causes harm, N = 4961 | does not cause harm, N = 4921 |
|---|---|---|
| disclosure/values | ||
| no disclosure | 163 (33%) | 165 (34%) |
| public health | 168 (34%) | 162 (33%) |
| economic growth | 165 (33%) | 165 (34%) |
| 1 n (%) | ||
write_reg_tbl(condition_tbl, here(out_dir, '03_condition_tbl'))
## Trust, overall ----
ggplot() +
geom_violin(aes(x = 'EMAD', pa_mean),
draw_quantiles = .5,
data = emad_df) +
geom_beeswarm(aes(x = 'EMAD', pa_mean),
data = emad_df) +
geom_violin(aes(x = 'HL', meti_mean),
draw_quantiles = .5,
data = dataf) +
geom_beeswarm(aes(x = 'HL', meti_mean),
data = dataf) +
ylab('mean trust')
Across our dataset, standard deviation of mean trust is 1.3 on the 1-7 scale
sd(dataf$meti_mean)
## [1] 1.288985
## H1. Modest correlation between values and ideology ----
(i) Political liberals are more likely to prioritize public health over economic growth, compared to political conservatives; but (ii) a majority of political conservatives prioritize public health.
NB 1. No DAG here because this isn’t a causal claim. 2. Direction of ideology coding is reversed between the two studies.
Compared to Elliott et al., our strong conservatives placed lower value on public health, and overall conservatives are about 50-50.
emad_df |>
count(ideology, tradeoff) |>
group_by(ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(ideology, n, fill = as.factor(tradeoff))) +
geom_col() +
scale_fill_viridis_d()
last_plot() + aes(y = share)
part_values_plot = dataf |>
filter(!is.na(pref)) |>
count(political_ideology, part_values) |>
group_by(political_ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(political_ideology, n, fill = part_values)) +
geom_col(color = 'black') +
scale_x_continuous(labels = NULL,
name = '← liberal conservative →\npolitical ideology') +
scale_fill_viridis_d(option = 'E', name = 'participant\nvalues')
part_values_plot
## Warning: Removed 2 rows containing missing values (position_stack).
part_values_share = part_values_plot + aes(y = share) +
scale_y_continuous(labels = scales::percent_format())
part_values_share
## Warning: Removed 2 rows containing missing values (position_stack).
part_values_plot + part_values_share +
plot_layout(guides = 'collect') +
plot_annotation(tag_levels = 'A')
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
ggsave(here(out_dir, '03_part_values.png'),
height = 4, width = 8, dpi = 200, scale = 1.5)
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
table(dataf$political_ideology, dataf$pref)
##
## 1 2 3 4
## 1 5 1 18 133
## 2 9 13 47 135
## 3 5 14 44 66
## 4 16 19 31 39
## 5 13 18 22 27
## 6 22 27 18 25
## 7 19 9 3 6
dataf |>
mutate(political_ideology = case_when(
political_ideology < 4 ~ 'liberal',
political_ideology == 4 ~ 'moderate',
political_ideology > 4 ~ 'conservative'
)) |>
count(political_ideology)
## # A tibble: 4 × 2
## political_ideology n
## <chr> <int>
## 1 conservative 248
## 2 liberal 574
## 3 moderate 118
## 4 <NA> 48
cor(emad_df$ideology, emad_df$tradeoff,
use = 'complete.obs',
method = 'spearman')
## [1] 0.2717778
cor(as.integer(dataf$political_ideology), as.integer(dataf$pref),
use = 'complete.obs',
method = 'spearman')
## [1] -0.4712353
glm(I(part_values == 'economic growth') ~ political_ideology,
family = 'binomial',
data = dataf) |>
summary()
##
## Call:
## glm(formula = I(part_values == "economic growth") ~ political_ideology,
## family = "binomial", data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5838 -0.6027 -0.4484 -0.3306 2.4225
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.51269 0.24200 -14.52 <2e-16 ***
## political_ideology 0.63300 0.05455 11.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 879.25 on 803 degrees of freedom
## Residual deviance: 711.42 on 802 degrees of freedom
## (184 observations deleted due to missingness)
## AIC: 715.42
##
## Number of Fisher Scoring iterations: 5
## DAG ----
We use the following DAG throughout the rest of this analysis
dag = dagify(METI ~ shared_values + sci_values +
part_values + demographics,
shared_values ~ part_values + sci_values,
part_values ~ demographics,
outcome = 'METI') |>
tidy_dagitty(layout = 'kk')
ggplot(dag, aes(x = x, y = y,
xend = xend, yend = yend)) +
geom_label(aes(label = name)) +
geom_dag_edges() +
coord_cartesian(clip = 'off') +
theme_dag()
## H2. Consumer risk sensitivity ----
Scientists who find that a chemical harms human health are perceived as more trustworthy than scientists who find that a chemical does not cause harm.
ggplot(emad_df, aes(conclusion, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
ggplot(dataf, aes(conclusion, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
Because the conclusion is experimentally manipulated, we don’t need any adjustments.
dag |>
add_arrows('conclusion -> METI') |>
plot_adjustments(exposure = 'conclusion') +
scale_color_manual(values = 'black')
model_b_emad = lm(pa_mean ~ conclusion, data = emad_df)
summary(model_b_emad)
##
## Call:
## lm(formula = pa_mean ~ conclusion, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6131 -0.8536 0.1012 1.1464 2.4321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.61306 0.08953 62.693 < 2e-16 ***
## conclusion[does not cause harm] -1.04516 0.12415 -8.418 4.12e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.384 on 496 degrees of freedom
## Multiple R-squared: 0.125, Adjusted R-squared: 0.1233
## F-statistic: 70.87 on 1 and 496 DF, p-value: 4.121e-16
model_b = lm(meti_mean ~ conclusion, data = dataf)
summary(model_b)
##
## Call:
## lm(formula = meti_mean ~ conclusion, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8315 -0.7601 0.0256 0.8730 2.5158
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.47437 0.05346 102.40 <2e-16 ***
## conclusion[does not cause harm] -0.99019 0.07576 -13.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.191 on 986 degrees of freedom
## Multiple R-squared: 0.1477, Adjusted R-squared: 0.1468
## F-statistic: 170.8 on 1 and 986 DF, p-value: < 2.2e-16
plot_residuals(model_b)
## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(emad = model_b_emad,
hl = model_b),
str_detect(term, 'conclusion'))
tbl_regression(model_b, intercept = TRUE) |>
add_glance_table(include = c(r.squared, nobs, statistic, p.value))
| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | |||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.148 | ||
| No. Obs. | 988 | ||
| Statistic | 171 | ||
| p-value | <0.001 | ||
| 1 CI = Confidence Interval | |||
list(emad = model_b_emad,
hl = model_b) |>
reg_tbl()
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.6 | 5.4, 5.8 | <0.001 | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.3, -0.80 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.125 | 0.148 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.123 | 0.147 | ||||
| Statistic | 70.9 | 171 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
## H3. Transparency penalty ----
Scientists who disclose values are perceived as less trustworthy than scientists who do not.
trans_plot_emad = ggplot(emad_df, aes(disclosure, pa_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_emad
## No summary function supplied, defaulting to `mean_se()`
trans_plot_us = ggplot(dataf, aes(disclosure, meti_mean)) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_us
## No summary function supplied, defaulting to `mean_se()`
trans_plot_emad +
ggtitle('EMAD') +
trans_plot_us +
ggtitle('HL replication')
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
ggsave(here(out_dir, '03_transparency.png'),
height = 3, width = 6, scale = 1,
bg = 'white')
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
Again, disclosure/transparency is experimentally controlled, so no adjustment is required.
dag |>
add_arrows('disclose -> METI') |>
plot_adjustments('disclose') +
scale_color_manual(values = 'black')
model_c_emad = lm(pa_mean ~ disclosure, data = emad_df)
summary(model_c_emad)
##
## Call:
## lm(formula = pa_mean ~ disclosure, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3917 -0.9519 0.1798 1.2231 2.0802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.3917 0.1164 46.316 < 2e-16 ***
## disclosure[TRUE] -0.4719 0.1409 -3.349 0.000871 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.463 on 496 degrees of freedom
## Multiple R-squared: 0.02212, Adjusted R-squared: 0.02015
## F-statistic: 11.22 on 1 and 496 DF, p-value: 0.0008714
model_c = lm(meti_mean ~ disclosure, data = dataf)
summary(model_c)
##
## Call:
## lm(formula = meti_mean ~ disclosure, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9447 -0.9120 0.0880 0.9839 2.0553
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.05488 0.07115 71.045 <2e-16 ***
## disclosure[TRUE] -0.11018 0.08705 -1.266 0.206
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.289 on 986 degrees of freedom
## Multiple R-squared: 0.001622, Adjusted R-squared: 0.0006095
## F-statistic: 1.602 on 1 and 986 DF, p-value: 0.2059
plot_residuals(model_c)
## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_c, 'disclosure')
plot_estimate(list(emad = model_c_emad,
hl = model_c),
str_detect(term, 'disclosure'))
list(emad = model_c_emad,
hl = model_c) |>
reg_tbl()
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.4 | 5.2, 5.6 | <0.001 | 5.1 | 4.9, 5.2 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.47 | -0.75, -0.20 | <0.001 | -0.11 | -0.28, 0.06 | 0.2 |
| R² | 0.022 | 0.002 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.020 | 0.001 | ||||
| Statistic | 11.2 | 1.60 | ||||
| p-value | <0.001 | 0.2 | ||||
| 1 CI = Confidence Interval | ||||||
## H2 + H3 combined table ----
model_bc_emad = lm(pa_mean ~ conclusion + disclosure, data = emad_df)
model_bc = lm(meti_mean ~ conclusion + disclosure, data = dataf)
bc_tbl = list(emad = model_bc_emad,
hl = model_bc) |>
reg_tbl()
bc_tbl
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 6.0 | 5.7, 6.2 | <0.001 | 5.6 | 5.4, 5.7 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.1 | -1.3, -0.82 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.52 | -0.78, -0.26 | <0.001 | -0.12 | -0.28, 0.04 | 0.14 |
| R² | 0.152 | 0.150 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.148 | 0.148 | ||||
| Statistic | 44.3 | 86.6 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
write_reg_tbl(bc_tbl, here(out_dir, '03_bc_tbl'))
## Scientist values ----
We didn’t specify this possibility in advance, but the analysis for H4 suggests scientist values, not shared values, have an effect. This is randomly assigned, so no adjustments needed.
plot_adjustments(dag, 'sci_values') +
scale_color_manual(values = 'black')
model_emad_s = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ sci_values, data = .)
model_s = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values, data = .)
summary(model_s)
##
## Call:
## lm(formula = meti_mean ~ sci_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8398 -0.8565 -0.0496 1.0185 2.3790
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.62100 0.07089 65.185 < 2e-16 ***
## sci_values[public health] 0.64740 0.10025 6.458 2.07e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.288 on 658 degrees of freedom
## Multiple R-squared: 0.0596, Adjusted R-squared: 0.05817
## F-statistic: 41.7 on 1 and 658 DF, p-value: 2.067e-10
plot_estimate(list('emad' = model_emad_s,
'hl' = model_s),
str_detect(term, 'sci_values'))
dataf |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(dodge.width = 1, alpha = .25) +
geom_ribbon(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = .25, group = 1L, fill = 'blue') +
geom_line(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = 1, group = 1L, fill = 'blue')
## Warning: Ignoring unknown parameters: fill
## Warning: Ignoring unknown aesthetics: ymin, ymax
For the paper, we’ll combine all of these models into one big table
shared_values_tbl = list(univariate = tbl_regression(model_d3,
intercept = TRUE,
label = c(shared_values ~ 'shared values')),
sci_values = tbl_regression(model_d2,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values')),
part_values = tbl_regression(model_d,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values')),
demo = tbl_regression(model_d1,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values',
religious_serv ~ 'rel. serv. attendance',
political_ideology ~ 'political id.'),
include = -c(gender, race_ethnicity,
religious_affil)),
sci_values_alone = tbl_regression(model_s,
intercept = TRUE,
label = c(sci_values ~ 'scientist values'))) |>
map(add_glance_table, include = c(r.squared, nobs, adj.r.squared,
statistic, p.value)) |>
tbl_merge(tab_spanner = c('(1) univariate',
'(2) scientist values',
'(3) participant values',
'(4) demographics',
'(5) scientist values alone')) |>
modify_table_body(~ arrange(.x, row_type == "glance_statistic"))
shared_values_tbl
| Characteristic | (1) univariate | (2) scientist values | (3) participant values | (4) demographics | (5) scientist values alone | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 4.7 | 4.5, 4.9 | <0.001 | 4.6 | 4.4, 4.7 | <0.001 | 4.7 | 4.5, 5.0 | <0.001 | 4.5 | 3.7, 5.3 | <0.001 | 4.6 | 4.5, 4.8 | <0.001 |
| shared values | |||||||||||||||
| shared_values[TRUE] | 0.47 | 0.25, 0.68 | <0.001 | 0.11 | -0.15, 0.37 | 0.4 | 0.10 | -0.16, 0.36 | 0.5 | 0.07 | -0.21, 0.35 | 0.6 | |||
| scientist values | |||||||||||||||
| sci_values[public health] | 0.62 | 0.36, 0.88 | <0.001 | 0.63 | 0.37, 0.89 | <0.001 | 0.62 | 0.34, 0.90 | <0.001 | 0.65 | 0.45, 0.84 | <0.001 | |||
| participant values | |||||||||||||||
| part_values[public health] | -0.18 | -0.44, 0.08 | 0.2 | -0.17 | -0.49, 0.15 | 0.3 | |||||||||
| age | 0.00 | -0.01, 0.01 | 0.7 | ||||||||||||
| rel. serv. attendance | 0.01 | -0.08, 0.10 | 0.9 | ||||||||||||
| political id. | -0.01 | -0.09, 0.06 | 0.8 | ||||||||||||
| education | 0.05 | -0.18, 0.28 | 0.6 | ||||||||||||
| R² | 0.031 | 0.067 | 0.070 | 0.143 | 0.060 | ||||||||||
| No. Obs. | 567 | 567 | 567 | 538 | 660 | ||||||||||
| Adjusted R² | 0.029 | 0.064 | 0.065 | 0.065 | 0.058 | ||||||||||
| Statistic | 18.0 | 20.3 | 14.1 | 1.83 | 41.7 | ||||||||||
| p-value | <0.001 | <0.001 | <0.001 | 0.001 | <0.001 | ||||||||||
| 1 CI = Confidence Interval | |||||||||||||||
write_reg_tbl(shared_values_tbl, here(out_dir, '03_shared_values_tbl'))
## H5. Variation in effects ----
The magnitude of the effects above vary depending on whether the participant prioritizes public health or economic growth.
## H5-consumer ----
For consumer risk and transparency penalty, bringing in participant values introduces a potential back-door path through demographics. This is very similar to shared values. Fortunately, as also with shared values, we just need to adjust for part_values (and conclusion).
dag |>
add_arrows(c('part_values -> conclusion_x_part_values <- conclusion',
'conclusion_x_part_values -> METI <- conclusion')) |>
plot_adjustments('conclusion_x_part_values')
model_eb_emad = lm(pa_mean ~ conclusion*part_values, data = emad_df)
summary(model_eb_emad)
##
## Call:
## lm(formula = pa_mean ~ conclusion * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.7437 -0.8610 0.1599 1.0251 2.5965
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.4116 0.1417
## conclusion[does not cause harm] -0.5505 0.2026
## part_values[public health] 0.3321 0.1819
## conclusion[does not cause harm]:part_values[public health] -0.7897 0.2557
## t value Pr(>|t|)
## (Intercept) 38.189 < 2e-16 ***
## conclusion[does not cause harm] -2.717 0.00682 **
## part_values[public health] 1.826 0.06853 .
## conclusion[does not cause harm]:part_values[public health] -3.089 0.00213 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.374 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.1429, Adjusted R-squared: 0.1377
## F-statistic: 27.35 on 3 and 492 DF, p-value: 2.243e-16
model_eb = lm(meti_mean ~ conclusion*part_values, data = dataf)
summary(model_eb)
##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9199 -0.7056 0.0087 0.8658 2.6042
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.3876 0.1131
## conclusion[does not cause harm] -0.7541 0.1673
## part_values[public health] 0.1752 0.1312
## conclusion[does not cause harm]:part_values[public health] -0.4128 0.1912
## t value Pr(>|t|)
## (Intercept) 47.632 < 2e-16 ***
## conclusion[does not cause harm] -4.509 7.45e-06 ***
## part_values[public health] 1.335 0.1823
## conclusion[does not cause harm]:part_values[public health] -2.159 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.175 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.1763, Adjusted R-squared: 0.1734
## F-statistic: 59.95 on 3 and 840 DF, p-value: < 2.2e-16
plot_residuals(model_eb)
## `geom_smooth()` using formula 'y ~ x'
plot_predictions(model_eb, c('conclusion', 'part_values'),
interaction_ci = TRUE)
plot_estimate(list(base = model_b, interaction = model_eb),
str_detect(term, 'conclusion'))
list(base = model_b, interaction = model_eb) |>
reg_tbl(labs = c('base', 'interaction'))
| Characteristic | base | interaction | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 |
| part_values | ||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | |||
| conclusion * part_values | ||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | |||
| R² | 0.148 | 0.176 | ||||
| No. Obs. | 988 | 844 | ||||
| Adjusted R² | 0.147 | 0.173 | ||||
| Statistic | 171 | 59.9 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
Again, include demographics as a check
model_eb1 = lm(meti_mean ~ conclusion*part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
summary(model_eb1)
##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values + age + gender +
## race_ethnicity + religious_affil + religious_serv + political_ideology +
## education, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.703 -0.689 0.000 0.815 2.839
##
## Coefficients: (1 not defined because of singularities)
## Estimate
## (Intercept) 5.269896
## conclusion[does not cause harm] -0.725321
## part_values[public health] 0.199800
## age 0.002336
## gender[Man/Male.Man/Male] 0.061406
## gender[Man/Male.Woman/Female] 0.668535
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -1.420756
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.319357
## gender[Woman/Female.Man/Male] -0.811087
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.813567
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.510207
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.197609
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.392368
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.803310
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.415886
## gender[Woman/Female.Woman/Female & Man/Male] 1.022698
## race_ethnicity[3] 0.169188
## race_ethnicity[2] 0.008730
## race_ethnicity[4] 0.296248
## race_ethnicity[2,5] -0.344107
## race_ethnicity[4,5] 0.235121
## race_ethnicity[1,5] -0.186294
## race_ethnicity[3,5] 0.620084
## race_ethnicity[1] 0.247225
## race_ethnicity[6] 0.134925
## race_ethnicity[3,4] 0.542722
## race_ethnicity[1,3] 0.652296
## race_ethnicity[1,3,5] 1.425109
## race_ethnicity[1,4,5] -0.506392
## race_ethnicity[2,4,5] 0.910759
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.774866
## religious_affil[6] 0.266205
## religious_affil[2] 0.145139
## religious_affil[8] 0.491350
## religious_affil[9] 0.024232
## religious_affil[4] 0.647875
## religious_affil[1] 0.366487
## religious_affil[5] 0.671171
## religious_affil[3] 0.081191
## religious_affil[7,8] 0.570199
## religious_affil[1,2] 0.535704
## religious_affil[1,6] -0.854535
## religious_affil[1,7] 0.481840
## religious_affil[2,7] 0.009369
## religious_affil[4,7] 0.682151
## religious_affil[6,9] 1.667394
## religious_affil[8,9] 1.191154
## religious_serv -0.014953
## political_ideology -0.022497
## education -0.043906
## conclusion[does not cause harm]:part_values[public health] -0.463876
## Std. Error
## (Intercept) 0.297492
## conclusion[does not cause harm] 0.176724
## part_values[public health] 0.148537
## age 0.002882
## gender[Man/Male.Man/Male] 0.087234
## gender[Man/Male.Woman/Female] 0.834456
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.682826
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.623232
## gender[Woman/Female.Man/Male] 0.593137
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 1.169456
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.876076
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.183602
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.168886
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 1.170160
## gender[Man/Male.Indigenous or other cultural gender minority identity] 1.229431
## gender[Woman/Female.Woman/Female & Man/Male] 1.181591
## race_ethnicity[3] 0.133069
## race_ethnicity[2] 0.192705
## race_ethnicity[4] 0.245233
## race_ethnicity[2,5] 0.399441
## race_ethnicity[4,5] 0.481519
## race_ethnicity[1,5] 0.559966
## race_ethnicity[3,5] 0.485083
## race_ethnicity[1] 0.589822
## race_ethnicity[6] 0.606086
## race_ethnicity[3,4] 0.711323
## race_ethnicity[1,3] 1.187150
## race_ethnicity[1,3,5] 1.171498
## race_ethnicity[1,4,5] 1.170419
## race_ethnicity[2,4,5] 1.175382
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 1.291521
## religious_affil[6] 0.130309
## religious_affil[2] 0.156570
## religious_affil[8] 0.167107
## religious_affil[9] 0.233107
## religious_affil[4] 0.289311
## religious_affil[1] 0.368428
## religious_affil[5] 0.499712
## religious_affil[3] 0.514410
## religious_affil[7,8] 0.830187
## religious_affil[1,2] 1.191750
## religious_affil[1,6] 1.168884
## religious_affil[1,7] 1.185778
## religious_affil[2,7] 1.173376
## religious_affil[4,7] 1.168637
## religious_affil[6,9] 1.169145
## religious_affil[8,9] 1.664191
## religious_serv 0.035004
## political_ideology 0.028822
## education 0.086157
## conclusion[does not cause harm]:part_values[public health] 0.202327
## t value
## (Intercept) 17.714
## conclusion[does not cause harm] -4.104
## part_values[public health] 1.345
## age 0.811
## gender[Man/Male.Man/Male] 0.704
## gender[Man/Male.Woman/Female] 0.801
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -2.081
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -2.117
## gender[Woman/Female.Man/Male] -1.367
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.551
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.582
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.012
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.191
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.686
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.152
## gender[Woman/Female.Woman/Female & Man/Male] 0.866
## race_ethnicity[3] 1.271
## race_ethnicity[2] 0.045
## race_ethnicity[4] 1.208
## race_ethnicity[2,5] -0.861
## race_ethnicity[4,5] 0.488
## race_ethnicity[1,5] -0.333
## race_ethnicity[3,5] 1.278
## race_ethnicity[1] 0.419
## race_ethnicity[6] 0.223
## race_ethnicity[3,4] 0.763
## race_ethnicity[1,3] 0.549
## race_ethnicity[1,3,5] 1.216
## race_ethnicity[1,4,5] -0.433
## race_ethnicity[2,4,5] 0.775
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.374
## religious_affil[6] 2.043
## religious_affil[2] 0.927
## religious_affil[8] 2.940
## religious_affil[9] 0.104
## religious_affil[4] 2.239
## religious_affil[1] 0.995
## religious_affil[5] 1.343
## religious_affil[3] 0.158
## religious_affil[7,8] 0.687
## religious_affil[1,2] 0.450
## religious_affil[1,6] -0.731
## religious_affil[1,7] 0.406
## religious_affil[2,7] 0.008
## religious_affil[4,7] 0.584
## religious_affil[6,9] 1.426
## religious_affil[8,9] 0.716
## religious_serv -0.427
## political_ideology -0.781
## education -0.510
## conclusion[does not cause harm]:part_values[public health] -2.293
## Pr(>|t|)
## (Intercept) < 2e-16
## conclusion[does not cause harm] 4.5e-05
## part_values[public health] 0.17899
## age 0.41789
## gender[Man/Male.Man/Male] 0.48170
## gender[Man/Male.Woman/Female] 0.42329
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.03780
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.03459
## gender[Woman/Female.Man/Male] 0.17189
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.12138
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.56049
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 0.31194
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 0.23396
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.49261
## gender[Man/Male.Indigenous or other cultural gender minority identity] 0.24983
## gender[Woman/Female.Woman/Female & Man/Male] 0.38703
## race_ethnicity[3] 0.20397
## race_ethnicity[2] 0.96388
## race_ethnicity[4] 0.22742
## race_ethnicity[2,5] 0.38925
## race_ethnicity[4,5] 0.62549
## race_ethnicity[1,5] 0.73946
## race_ethnicity[3,5] 0.20154
## race_ethnicity[1] 0.67523
## race_ethnicity[6] 0.82389
## race_ethnicity[3,4] 0.44572
## race_ethnicity[1,3] 0.58285
## race_ethnicity[1,3,5] 0.22418
## race_ethnicity[1,4,5] 0.66539
## race_ethnicity[2,4,5] 0.43867
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 0.16978
## religious_affil[6] 0.04141
## religious_affil[2] 0.35423
## religious_affil[8] 0.00338
## religious_affil[9] 0.91724
## religious_affil[4] 0.02542
## religious_affil[1] 0.32019
## religious_affil[5] 0.17964
## religious_affil[3] 0.87463
## religious_affil[7,8] 0.49240
## religious_affil[1,2] 0.65319
## religious_affil[1,6] 0.46497
## religious_affil[1,7] 0.68460
## religious_affil[2,7] 0.99363
## religious_affil[4,7] 0.55959
## religious_affil[6,9] 0.15424
## religious_affil[8,9] 0.47436
## religious_serv 0.66937
## political_ideology 0.43532
## education 0.61048
## conclusion[does not cause harm]:part_values[public health] 0.02214
##
## (Intercept) ***
## conclusion[does not cause harm] ***
## part_values[public health]
## age
## gender[Man/Male.Man/Male]
## gender[Man/Male.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] *
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] *
## gender[Woman/Female.Man/Male]
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]
## gender[Man/Male.Indigenous or other cultural gender minority identity]
## gender[Woman/Female.Woman/Female & Man/Male]
## race_ethnicity[3]
## race_ethnicity[2]
## race_ethnicity[4]
## race_ethnicity[2,5]
## race_ethnicity[4,5]
## race_ethnicity[1,5]
## race_ethnicity[3,5]
## race_ethnicity[1]
## race_ethnicity[6]
## race_ethnicity[3,4]
## race_ethnicity[1,3]
## race_ethnicity[1,3,5]
## race_ethnicity[1,4,5]
## race_ethnicity[2,4,5]
## race_ethnicity[5,6]
## race_ethnicity[6,7]
## religious_affil[6] *
## religious_affil[2]
## religious_affil[8] **
## religious_affil[9]
## religious_affil[4] *
## religious_affil[1]
## religious_affil[5]
## religious_affil[3]
## religious_affil[7,8]
## religious_affil[1,2]
## religious_affil[1,6]
## religious_affil[1,7]
## religious_affil[2,7]
## religious_affil[4,7]
## religious_affil[6,9]
## religious_affil[8,9]
## religious_serv
## political_ideology
## education
## conclusion[does not cause harm]:part_values[public health] *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.164 on 750 degrees of freedom
## (187 observations deleted due to missingness)
## Multiple R-squared: 0.2364, Adjusted R-squared: 0.1855
## F-statistic: 4.645 on 50 and 750 DF, p-value: < 2.2e-16
eb_tbl = list(base = model_b, interaction = model_eb, demo = model_eb1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
eb_tbl
| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 | 5.3 | 4.7, 5.9 | <0.001 |
| conclusion | |||||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 | -0.73 | -1.1, -0.38 | <0.001 |
| part_values | |||||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | 0.20 | -0.09, 0.49 | 0.2 | |||
| conclusion * part_values | |||||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | -0.46 | -0.86, -0.07 | 0.022 | |||
| age | 0.00 | 0.00, 0.01 | 0.4 | ||||||
| religious_serv | -0.01 | -0.08, 0.05 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.03 | 0.4 | ||||||
| education | -0.04 | -0.21, 0.13 | 0.6 | ||||||
| R² | 0.148 | 0.176 | 0.236 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.147 | 0.173 | 0.186 | ||||||
| Statistic | 171 | 59.9 | 4.64 | ||||||
| p-value | <0.001 | <0.001 | <0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(eb_tbl, here(out_dir, '03_eb_tbl'))
emad_df |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, pa_mean)) +
geom_boxplot() +
facet_wrap(vars(part_values))
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, meti_mean)) +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
facet_wrap(vars(part_values)) +
labs(x = 'scientist conclusion: BPA ...',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_conclusion_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')
## H5-transparency ----
dag |>
add_arrows(c('part_values -> disclosure_x_part_values <- disclosure',
'disclosure_x_part_values -> METI',
'disclosure -> METI')) |>
plot_adjustments('disclosure_x_part_values')
model_ec_emad = lm(pa_mean ~ disclosure*part_values, data = emad_df)
summary(model_ec_emad)
##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4090 -1.0042 0.1387 1.1446 2.1387
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.35272 0.18476 28.971
## disclosure[TRUE] -0.32001 0.22784 -1.405
## part_values[public health] 0.05629 0.23878 0.236
## disclosure[TRUE]:part_values[public health] -0.22770 0.29095 -0.783
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.161
## part_values[public health] 0.814
## disclosure[TRUE]:part_values[public health] 0.434
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.02353, Adjusted R-squared: 0.01758
## F-statistic: 3.953 on 3 and 492 DF, p-value: 0.008371
lm(pa_mean ~ disclosure*part_values+
sex + ideology + educatio + age, data = emad_df) |>
summary()
##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values + sex + ideology +
## educatio + age, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.2393 -0.9427 0.1744 1.1730 2.2864
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.227099 0.334903 15.608
## disclosure[TRUE] -0.323021 0.228681 -1.413
## part_values[public health] 0.003625 0.243423 0.015
## sex 0.025026 0.134675 0.186
## ideology 0.007676 0.042153 0.182
## educatio -0.084100 0.064652 -1.301
## age 0.069062 0.031725 2.177
## disclosure[TRUE]:part_values[public health] -0.256452 0.291972 -0.878
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.158
## part_values[public health] 0.988
## sex 0.853
## ideology 0.856
## educatio 0.194
## age 0.030 *
## disclosure[TRUE]:part_values[public health] 0.380
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.459 on 484 degrees of freedom
## (6 observations deleted due to missingness)
## Multiple R-squared: 0.03626, Adjusted R-squared: 0.02232
## F-statistic: 2.601 on 7 and 484 DF, p-value: 0.01212
model_ec = lm(meti_mean ~ disclosure*part_values, data = dataf)
summary(model_ec)
##
## Call:
## lm(formula = meti_mean ~ disclosure * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9023 -0.9061 0.0977 1.0263 2.0977
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.01557 0.14634 34.273
## disclosure[TRUE] 0.04464 0.18767 0.238
## part_values[public health] 0.07453 0.17265 0.432
## disclosure[TRUE]:part_values[public health] -0.23243 0.21762 -1.068
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.812
## part_values[public health] 0.666
## disclosure[TRUE]:part_values[public health] 0.286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.292 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.004245, Adjusted R-squared: 0.0006885
## F-statistic: 1.194 on 3 and 840 DF, p-value: 0.3111
plot_residuals(model_ec)
## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(base = model_c, interaction = model_ec),
str_detect(term, 'disclosure'))
plot_predictions(model_ec, c('disclosure', 'part_values'),
interaction_ci = TRUE)
model_ec1 = lm(meti_mean ~ disclosure * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
ec_tbl = list(base = model_c,
interaction = model_ec,
demographics = model_ec1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
ec_tbl
| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.1 | 4.9, 5.2 | <0.001 | 5.0 | 4.7, 5.3 | <0.001 | 4.9 | 4.3, 5.6 | <0.001 |
| disclosure | |||||||||
| disclosure[TRUE] | -0.11 | -0.28, 0.06 | 0.2 | 0.04 | -0.32, 0.41 | 0.8 | 0.05 | -0.34, 0.43 | 0.8 |
| part_values | |||||||||
| part_values[public health] | 0.07 | -0.26, 0.41 | 0.7 | 0.14 | -0.23, 0.51 | 0.5 | |||
| disclosure * part_values | |||||||||
| disclosure[TRUE] * part_values[public health] | -0.23 | -0.66, 0.19 | 0.3 | -0.29 | -0.74, 0.15 | 0.2 | |||
| age | 0.00 | 0.00, 0.01 | 0.5 | ||||||
| religious_serv | 0.02 | -0.06, 0.09 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.04 | 0.5 | ||||||
| education | -0.07 | -0.26, 0.11 | 0.4 | ||||||
| R² | 0.002 | 0.004 | 0.071 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.001 | 0.001 | 0.009 | ||||||
| Statistic | 1.60 | 1.19 | 1.15 | ||||||
| p-value | 0.2 | 0.3 | 0.2 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(ec_tbl, here(out_dir, '03_ec_tbl'))
dataf |>
filter(!is.na(part_values)) |>
ggplot(aes(disclosure, meti_mean)) +
geom_boxplot() +
# geom_beeswarm(alpha = .25) +
facet_wrap(vars(part_values))
## Scientist values ---
The confusing “shared values interaction” effect is just the effect of scientist values, from H4
model_es = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values + part_values, data = .)
summary(model_es)
##
## Call:
## lm(formula = meti_mean ~ sci_values + part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8203 -0.8918 -0.0619 0.9659 2.4381
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.7479 0.1267 37.478 < 2e-16 ***
## sci_values[public health] 0.6870 0.1080 6.361 4.14e-10 ***
## part_values[public health] -0.1861 0.1318 -1.412 0.158
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 564 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.06916, Adjusted R-squared: 0.06586
## F-statistic: 20.95 on 2 and 564 DF, p-value: 1.671e-09
plot_predictions(model_es, 'sci_values')
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_boxplot() +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
facet_wrap(vars(part_values)) +
# geom_ribbon(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = .5, fill = 'blue') +
# geom_line(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = 1, color = 'blue') +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
labs(x = 'scientist values',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_sci_part.png'), height = 3, width = 6, scale = 1, bg = 'white')
Any interaction with participant values is swamped by uncertainty.
Though Emilio thinks this might be worth reporting because of difference in variation — wider for economic growth participants. OTOH there are just a lot fewer of these participants, so SEs are larger.
How are participants thinking of economic growth? Might be thinking of indirect effects, eg, good economy -> better hospitals and public health system
dataf %>%
filter(disclosure) %>%
lm(meti_mean ~ sci_values*part_values, data = .) |>
# summary()
plot_predictions(c('sci_values', 'part_values'),
interaction_ci = TRUE)
lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)) |>
summary()
##
## Call:
## lm(formula = meti_mean ~ sci_values * part_values, data = filter(dataf,
## disclosure))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 4.8193 0.1582
## sci_values[public health] 0.5301 0.2346
## part_values[public health] -0.2783 0.1799
## sci_values[public health]:part_values[public health] 0.1992 0.2643
## t value Pr(>|t|)
## (Intercept) 30.464 <2e-16 ***
## sci_values[public health] 2.259 0.0243 *
## part_values[public health] -1.547 0.1224
## sci_values[public health]:part_values[public health] 0.753 0.4515
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09
sci_part_tbl = list(base = model_s,
part_values = model_es,
interaction = lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)),
demographics = lm(meti_mean ~ sci_values * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = filter(dataf, disclosure))) |>
reg_tbl(labs = c('base', 'participant values',
'interaction', 'demographics'))
write_reg_tbl(sci_part_tbl, here(out_dir, '03_sci_part_tbl'))